home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / VISUALBA / BLTQ12.ZIP / XB_SRC01.BAS < prev    next >
BASIC Source File  |  1993-01-04  |  18KB  |  596 lines
  1. DECLARE FUNCTION DoBackup% (dfHandle%, kfHandle%)
  2. DECLARE FUNCTION DoExpandFile% (kfHandle%)
  3. DECLARE FUNCTION DoReindex% (kfHandle%)
  4. DECLARE FUNCTION DoAdd% (kfHandle%)
  5. DECLARE FUNCTION DoAddAll% (kfHandle%)
  6. DECLARE FUNCTION DoClose% (dfHandle%, kfHandle%)
  7. DECLARE FUNCTION DoCreateOpenDataFile% (dfHandle%)
  8. DECLARE FUNCTION DoCreateOpenKeyFile% (dfHandle%, kfHandle%)
  9. DECLARE FUNCTION DoExit% ()
  10. DECLARE FUNCTION DoFirstThings% (dfHandle%, kfHandle%)
  11. DECLARE FUNCTION DoGetEqual% (kfHandle%, match$)
  12. DECLARE FUNCTION DoMemCheck% ()
  13. DECLARE SUB DoPrint (kfHandle%, k$)
  14. DECLARE FUNCTION DoShowFirst% (kfHandle%)
  15. DECLARE FUNCTION DoShowNext% (kfHandle%)
  16. DECLARE FUNCTION GetKeyInfo% (kfHandle%, kfKeyFlags%, kfKeyLen%)
  17. DECLARE FUNCTION IsShareLoaded% ()
  18.  
  19. DEFINT A-Z
  20.  
  21. REM $INCLUDE: 'BULLET.BI'
  22. 'XB_SRC01.BAS 31-May-92 chh
  23. 'code example of a BULLET program that uses many of the BULLET routines--
  24. '--though not really that well designed--an early ad-hoc design test bed
  25.  
  26. TYPE ScoreRecTYPE
  27. tag AS STRING * 1       'MUST HAVE DELETE TAG SPACE DEFINED FOR BULLET USE
  28. codename AS STRING * 6
  29. score AS STRING * 4     'true DBF format has NUMERIC in ASCII, not binary form
  30. END TYPE '11
  31. DIM SHARED gScoreRec AS ScoreRecTYPE  'the only global variable
  32.  
  33. CONST MAXDF = 1         'max data files to be used concurrently (1-250)
  34. CONST MAXKF = 1         'max key files to be used concurrently (1-250)
  35. CONST MAXFD = 2         'max fields to be used concurrently (SUM of all!)
  36.                         '          (this program has only 2 fields total)
  37.                         'these values mainly for DoMemCheck here
  38.  
  39.                         'all variables are local to main and
  40.                         'are passed if needed elsewhere rather
  41.                         'than declaring then SHARED (why not)
  42.                                    'because...
  43. DIM SHARED dfHandle AS INTEGER    'DOS file handle to data file
  44. DIM SHARED kfHandle AS INTEGER    'DOS file handle to key file
  45.  
  46. 'note: if you run this program more than once without first deleting the
  47. 'two files this creates, then the program will end with a error 201 since
  48. 'the key file was created to all unique keys only (easy enough to change)
  49. '--also, the Creating status will indicate error 80 (&H50) "Already exists"
  50.  
  51. CLS
  52. PRINT "XSRC01.BAS"
  53. PRINT "----------Key: CHARACTER, NLS, DUPLICATES ALLOWED"
  54. stat = DoFirstThings(dfHandle, kfHandle)
  55. PRINT "Using DOS handles:"; dfHandle; kfHandle
  56. IF stat = 0 THEN
  57.    INPUT "How may add loops (max=32000 loops, each loop is 14 recs)", a
  58.    ts! = TIMER
  59.    FOR i = 1 TO a
  60.       stat = DoAddAll(dfHandle)
  61.       IF stat THEN EXIT FOR
  62.    NEXT
  63.    te! = TIMER
  64.    PRINT "add rec time"; te! - ts!
  65.    IF stat = 0 THEN
  66.       ts! = TIMER
  67.       stat = DoReindex(kfHandle)
  68.       te! = TIMER
  69.       IF stat = 0 THEN
  70.          stat = stat2
  71.          PRINT "reindex time"; te! - ts!
  72.          match$ = "SHARKY" + CHR$(0) + CHR$(0)
  73.          stat = DoGetEqual(kfHandle, match$)
  74.       END IF
  75.    END IF
  76. END IF
  77. PRINT "status:"; stat;
  78. SELECT CASE stat
  79. CASE 202
  80.    PRINT "Normal End Of File"
  81. CASE 201
  82.    PRINT "Keyfile created for UNIQUE keys and attempt to insert key that already exists"
  83.    PRINT "Either allow duplicate keys (in CreateKXB) or delete key or delete file"
  84. CASE ELSE
  85.    PRINT "Look it up"
  86. END SELECT
  87. END
  88.  
  89. 'data filename, number of fields
  90. '(for each field) name, type, length, decimal count
  91. DataFileInfo:
  92. DATA ".\XSRC01.DBF"
  93. DATA 2
  94. DATA "CODENAME","C",6,0
  95. DATA "SCORE","N",4,0
  96.  
  97. 'key filename, key expression, key flags (see DOCs for flags)
  98. KeyFileInfo:
  99. DATA ".\XSRC01.DEX"
  100. DATA "CODENAME"
  101. DATA 2
  102.  
  103. 'sample data for data file
  104. 'codename,score
  105. SampleData:
  106. DATA "SHARKY",100
  107. DATA "Sharki",47
  108. DATA "BRande",48
  109. DATA "BRANDI",95
  110. DATA "BWANA",66
  111. DATA "SaysSo",87
  112. DATA "SAYSNO",50
  113. DATA "SEXIMA",69
  114. DATA "BERLIN",55
  115. DATA "MUNICH",44
  116. DATA "FURTH",77
  117. DATA "Goanna",61
  118. DATA "Spock1",67
  119. DATA "SPOCK2",99
  120. DATA "",0
  121.  
  122. FUNCTION DoAdd (dfHandle)
  123.  
  124. 'add a new entry into the database, locking all bytes in the key and data
  125. 'files if SHARE.EXE is loaded preventing other processes from accessing
  126. 'the two files while we're making changes to them
  127.  
  128. DIM AP AS AccessPack
  129. DIM AnyKeyBuffer AS STRING * 64
  130.  
  131. ShareLoaded = IsShareLoaded
  132.  
  133. AP.Func = LockXB                    'first lock the key file and data file
  134. AP.Handle = dfHandle
  135. AP.RecPtrOff = VARPTR(gScoreRec)    'point to the data record
  136. AP.RecPtrSeg = VARSEG(gScoreRec)
  137. AP.KeyPtrOff = VARPTR(AnyKeyBuffer) 'point to the key buffer
  138. AP.KeyPtrSeg = VARSEG(AnyKeyBuffer)
  139. AP.NextPtrOff = 0                   'point to the next key file (none)
  140. AP.NextPtrSeg = 0
  141.  
  142. LOCATE , 1
  143. statLock = 0
  144. IF ShareLoaded THEN
  145.    AP.Handle = kfHandle             'want the kfHandle for the xaction lock
  146.    PRINT "Initiating locks";
  147.    stat = BULLET(AP)
  148.    IF stat THEN statLock = AP.stat
  149.    AP.Handle = dfHandle
  150. END IF
  151.  
  152. stat = statLock
  153. IF stat = 0 THEN                    'and now do the add
  154.    'AP.Handle = kfHandle
  155.    'AP.Func = InsertXB                  'both key and the data record
  156.                                         '!not for this example, using ReindexXB
  157.    AP.Func = AddRecordXB            'of just data record
  158.    PRINT " - adding rec: "; gScoreRec.codename;
  159.    stat = BULLET(AP)
  160.  
  161.    'since for InsertXB (and UpdateXB and LockXB) return not the
  162.    'error status but rather the key file position number (since we
  163.    'can Insert/Update/Lock up to 32 key files plus a data file at one
  164.    'time) we must explicity check for the error status in AP.stat
  165.    '(can still check AP.Stat even if not a xaction-based routine!)
  166.    stat = AP.stat
  167.    IF stat = 0 THEN PRINT " recno:"; AP.RecNo;
  168. END IF
  169.  
  170. IF ShareLoaded AND (statLock = 0) THEN
  171.    AP.Func = UnlockXB                  'if lock was successful must unlock
  172.    AP.Handle = kfHandle
  173.    PRINT " - released locks";
  174.    stat = BULLET(AP)
  175.    IF stat THEN stat = AP.stat
  176.    PRINT stat
  177. END IF
  178. DoAdd = stat
  179.  
  180. END FUNCTION
  181.  
  182. FUNCTION DoAddAll (dfHandle)
  183.  
  184. 'read the DATA codename and score and add it to the data file
  185. 'and insert its key to the key file
  186.  
  187. 'done for each of the sample data items in SampleData:
  188.  
  189. 'dfHandle is not needed because it is known to BULLET from the Open()
  190.  
  191. RESTORE SampleData
  192. DO
  193.    READ cname$, score$                  'score$ as string because DBF format
  194.    IF LEN(cname$) = 0 THEN EXIT DO      'specifies all data in DBF files be
  195.                                         'in ASCII format
  196.    gScoreRec.codename = cname$
  197.    RSET gScoreRec.score = score$        'right-justify score in field
  198.    stat = DoAdd(dfHandle)               'insert gScoreRec and its key
  199. LOOP UNTIL stat
  200. DoAddAll = stat
  201.  
  202. END FUNCTION
  203.  
  204. FUNCTION DoBackup (dfHandle, kfHandle)
  205.  
  206. 'backup the current files
  207.  
  208. DIM CP AS CopyPack
  209. DIM BUname AS STRING * 64
  210.  
  211. BUname = ".\XSRC01.D!F" + CHR$(0)
  212. CP.Func = BackupFileXB
  213. CP.Handle = dfHandle
  214. CP.FilenamePtrOff = VARPTR(BUname)
  215. CP.FilenamePtrSeg = VARSEG(BUname)
  216. stat = BULLET(CP)
  217.  
  218. IF stat = 0 THEN
  219.    BUname = ".\XSRC01.D!X" + CHR$(0)
  220.    CP.Func = BackupFileXB
  221.    CP.Handle = kfHandle
  222.    CP.FilenamePtrOff = VARPTR(BUname)
  223.    CP.FilenamePtrSeg = VARSEG(BUname)
  224.    stat = BULLET(CP)
  225. END IF
  226. DoBackup = stat
  227.  
  228. END FUNCTION
  229.  
  230. FUNCTION DoClose (dfHandle, kfHandle)
  231.  
  232. 'close key file first, then data file
  233.  
  234. DIM HP AS HandlePack
  235.  
  236. HP.Func = CloseKXB
  237. HP.Handle = kfHandle
  238. stat = BULLET(HP)
  239.  
  240. HP.Func = CloseDXB
  241. HP.Handle = dfHandle
  242. stat2 = BULLET(HP)
  243. IF stat = 0 THEN stat = stat2
  244. DoClose = stat
  245.  
  246. END FUNCTION
  247.  
  248. FUNCTION DoCreateOpenDataFile (dfHandle)
  249.  
  250. 'Create (if needed) and open data file
  251.  
  252. 'Rtn: dfHandle DOS file handle
  253.  
  254. '--Demonstrates ability to specify data file format at run-time without
  255. 'hard-coding it at compile-time. This info could easily be specified
  256. 'interactively from the user, an external file, etc.
  257.  
  258. 'FieldName MUST BE ZERO-FILLED TO CHARACTER POSITION 11
  259. 'technically, only A-Z and _ are allowed in DBF fieldnames
  260. 'also, all info should be in UPPER-CASE
  261.  
  262. DIM CDP AS CreateDataPack
  263. DIM OP AS OpenPack
  264.  
  265. DIM XBdf AS STRING * 64         'used only for create (must be FIXED-LENGTH)
  266.